perm filename MARK.SAI[X,ALS] blob
sn#087638 filedate 1974-02-21 generic text, type T, neo UTF8
00010 BEGIN "MARKX"
00020 DEFINE ⊂="COMMENT"; ⊂ NOV.26,1973;
00030 ⊂ This program is a very simple pitch marking routine to be used to
00040 suppliment Neil's routine in certain cases;
00050 DEFINE ⊃="⊂";
00060 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00070 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00080 LABEL STARTP,STOPP,TOFORM;
00090 DEFINE \=" "; ⊂ DEFINE \="SAFE"; ⊂ Alternarte definitions;
00100 INTEGER SUM,SUMM,SUMP,MAX,MIN,
00110 SUMREF,SUMSAV,SUMMIN,SUMMAX,SUMOLD;
00120 INTEGER MAXOLD,MINOLD,MARGIN,PER,PERMIN,PERMAX;
00130 INTEGER QOLD,QSAVE,QREF,QOLD2;
00140 INTEGER ZEROC,ZEROF,DX;
00150 \ INTERNAL INTEGER ARRAY D[0:767];
00160 \ INTEGER ARRAY DPYBUF[0:1535];
00170 \ INTERNAL INTEGER ARRAY FVAL,NVAL[0:8];
00180 INTEGER FX;
00190 INTEGER I,J,K,L,P,PP,Q,QQ,QNEG,QPOS,R,DK,DDK,DDDK,DVAL,DDVAL,DDDVAL,ALPHA,
00200 POINTF,POINTX,STATE,DELTA,DELTN,VAL,CHAN1,EOF,POINTT,POINTV;
00210 INTERNAL INTEGER M,N,PERIOD;
00220 INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,
00230 PTCNT,PICK,JP,JPP,JPX,OPT,OPT1,SHUFCT;
00240 INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,EOFT,EOFTF,READ3,LFX,PITX,PITY,
00250 SEGTOT,SEGIN,KKT,NNT,ITT,JTT,KTT;
00260 BOOLEAN ER;
00270 INTEGER CHAN3;
00280 INTERNAL INTEGER CHAN5;
00290 \ INTEGER ARRAY BUF,BUFTT[0:511];
00300 \ INTEGER ARRAY BUFT[0:1023];
00310 STRING FILEN,FILEF,READ,READ1,READT,
00320 READTT,FILEO,READ2,FILEQ,TFILE,FILLST,FILEP;
00330
00340 INTEGER ARRAY QRES,SUMRES,SPAN[0:7];
00350 INTEGER QX,XXP,XXM,GOOD,XING;
00360
00370
00380 PROCEDURE OUTALL(STRING S);
00390 BEGIN
00400 STRING SS; INTEGER J;
00410 SETBREAK(18,0,NULL,"OSN");
00420 SS←SCAN(S,18,J);
00430 OUTSTR(SS);
00440 END;
00450
00460 PROCEDURE DATAIN;
00470 BEGIN
00480 INTEGER J;
00490 FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00500 ⊂ IF EOF=0 THEN OUTSTR("BUF") ELSE OUTSTR(" EOF ");
00510 IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512) ELSE OUTSTR("Out of data"&crlf);
00520 ⊂ IF EOF=0 THEN OUTSTR(" New BUF ") ELSE OUTSTR(" EOF ");
00530 POINTX←POINT(12,BUF[0],-1);
00540 SEGC←II←II+12; JJ←II+11;
00550 END;
00560
00570
00580 PROCEDURE DTTTIN;
00590 BEGIN
00600 INTEGER J;
00610 IF EOFT=0 THEN ARRYIN(CHAN3,BUFTT[0],512)
00620 ELSE OUTSTR
00630 ("No more .P data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00640 FOR J←0 STEP 1 UNTIL 511 DO IF BUFTT[J]=0 THEN BUFTT[J]←'377777777777;
00650 ITT←BUFTT[0] LSH -15; KTT←0; JTT←BUFTT[511] LSH -15;
00660 ⊂ FOR J←0 STEP 1 UNTIL 10 DO OUTSTR(CVOS(BUFTT[J])&TB);
00670 END;
00680
00690
00700 PROCEDURE DATOUT;
00710 BEGIN "DATOUT"
00720 INTEGER I,J;
00730
00740 ARRYOUT(CHAN5,BUFT[0],1024);
00750 FOR I←0 STEP 1 UNTIL 1023 DO BUFT[I]←0;
00760 END "DATOUT";
00770
00780
00790 PROCEDURE MARK;
00800 BEGIN "MARK"
00810 INTEGER I,JJ,K,L,JJP,LP,PT2;
00820
00830 RIVECT(0,-230); SETFORMAT(3,0);
00840 FOR I←0 STEP 20 UNTIL 340 DO BEGIN
00850 DPYSST(CVS(I)); RIVECT(15,0); END;
00860 RIVECT(-555,30); RIVECT(-500,0);
00870
00880 FOR I←0 STEP 100 UNTIL 300 DO BEGIN "HUNDRED"
00890 RIVECT(0,30); RVECT(0,-30);
00900 FOR JJ←0 STEP 50 UNTIL 50 DO BEGIN "FIFTY"
00910 FOR K←1 STEP 1 UNTIL 5 DO BEGIN "TEN"
00920 RIVECT(15,0); RVECT(0,5); RIVECT(0,-5);
00930 RIVECT(15,0); RVECT(0,10);RIVECT(0,-10);
00940 END "TEN";
00950 RVECT(0,20); RIVECT(0,-20);
00960 IF I≥300 THEN DONE "HUNDRED";
00970 END "FIFTY";
00980 END "HUNDRED";
00990 RIVECT(-550,200); RIVECT(-500,0);
01000
01010 K←D[0]%8; RIVECT(0,K);
01020 FOR I←1 STEP 1 UNTIL 350 DO BEGIN
01030 JJP←D[I]%6;
01040 LP←JJP-K; RVECT(3,LP); K←JJP; END;
01050 RIVECT(-550,-K); RIVECT(-500,0);
01060
01070 RIVECT(500,0);
01080 FOR JJ←1 STEP 1 UNTIL 2 DO IF FVAL[JJ]≤350 THEN BEGIN
01090 L←3*FVAL[JJ]-500;
01100 RIVECT(L,200); RVECT(0,-200);
01110 RIVECT(-25,0); RVECT(50,0);
01120 RIVECT(-25,0); RIVECT(-L,0); END;
01130
01140 FOR JJ←1 STEP 1 UNTIL 2 DO IF NVAL[JJ]≤350 THEN BEGIN
01150 L←3*NVAL[JJ]-500;
01160 RIVECT(L,0);RIVECT(-25,0); RVECT(50,0);
01170 RIVECT(-25,0); RVECT(0,-200); RIVECT(-L,200); END;
01180
01190 RIVECT(-500,0);
01200 DPYOUT(0); PTOCHW(0,'10120); SETFORMAT(1,0);
01210
01220
01230 END "MARK";
01240
01250 INTERNAL PROCEDURE CALCOMP(STRING FILE;INTEGER ARRAY BUFR);
01260 ⊂ Outputs display buffer BUFR to disk file FILE in a format
01270 readable by the Nealy Calcomp plotter program PLTVEC, and by
01280 the Quam Video Synthesizer program MIRTOP;
01290 IF FILE THEN
01300 BEGIN INTEGER DSIZ,CCCHN;
01310 OPEN(CCCHN←GETCHAN,"DSK",'14,0,1,0,0,0);
01320 ENTER(CCCHN,FILEN&".GRF",0);
01330 DPYPARS;DSIZ←BUFR[1]+4;
01340 ARRYOUT(CCCHN,BUFR[0],2);WORDOUT(CCCHN,0);
01350 ARRYOUT(CCCHN,BUFR[2],DSIZ-2);
01360 RELEASE(CCCHN);
01370 END "CALCOMP";
01380
01390
01400 PROCEDURE PEEK;
01410 BEGIN
01420
01430 OUTSTR(CRLF&"Q'S "&CVS(QREF)&" "&CVS(QSAVE)&" "&CVS(QOLD)&TB&" P="&CVS(P)&
01440 TB&"SUM'S "&CVS(SUMREF)&" "&CVS(SUMSAV)&" "&CVS(SUMOLD)&
01450 TB&"PERIOD="&CVS(PERIOD)&" "&CVS(PER)&CRLF);
01460 END;
01470
01480 PROCEDURE SPOR;
01490 BEGIN
01500 OUTSTR(CVS(STATE)&" ");
01510 END;
01520
01530 PROCEDURE PITCH;
01540 BEGIN "PITCH"
01550
01560 CASE STATE OF BEGIN
01570
01580 ⊂ State 0 from 2 on - ;
01590 IF VAL>0 THEN BEGIN
01600 STATE←2; QOLD←QQ; SUMP←MAX←VAL; XING←XING+1;
01610 ⊃ SPOR;
01620 END;
01630
01640 ⊂ STATE 1 from 5 on + ;
01650 IF VAL<0 THEN BEGIN
01660 IF XXP<2 THEN BEGIN
01670 STATE←5; SUM←SUM+SUMP-VAL;
01680 ⊃ SPOR;
01690 IF MAXOLD>MAX THEN MAX←MAXOLD;
01700 END;
01710 END ELSE BEGIN
01720 SUMP←SUMP+VAL;
01730 IF VAL>MAX THEN MAX←VAL;
01740 IF SUMP>DELTA THEN BEGIN
01750 STATE←2; SUM←0;
01760 ⊃ SPOR;
01770 ⊂ PEEK;
01780 ⊂ Decision;
01790 P←0;
01800 IF XING≥15 THEN P←0 ELSE
01810 IF (GOOD<2)∧(XING<5)∧(SUMOLD>SUMSAV)∧((QOLD-QSAVE)>PERIOD%4)
01820 THEN P←1 ELSE
01830 IF (SUMREF=SUMSAV)∧(PER>PERIOD*3%4)∧(QOLD-QSAVE>PERIOD*3%4)
01840 THEN P←2 ELSE
01850 IF (SUMOLD<SUMSAV) THEN SUMSAV←SUMOLD ELSE
01860 IF (SUMOLD>SUMSAV*4%3)∧(PER>PERIOD*7%8)∧(SUMOLD>SUMREF%2)
01870 THEN P←3 ELSE
01880 IF (SUMOLD>SUMSAV*5%4)∧(PER>PERIOD*9%10)∧(SUMOLD>SUMMIN)
01890 THEN P←4 ELSE
01900 IF (SUMREF≤SUMMIN)∧(SUMOLD>SUMREF)
01910 THEN P←5 ELSE
01920 IF (SUMOLD>SUMREF*5%4)∧(PER>PERIOD*5%8)
01930 THEN P←6; ⊂ To get in step;
01940 IF (PER>PERIOD*3%2)∧(P=0)∧(XING≤15) THEN BEGIN
01950 K←0;
01960 FOR I←0 STEP 1 UNTIL 7 DO
01970 IF SUMRES[I]>K THEN BEGIN K←SUMRES[I]; QX←I; END;
01980 IF K>2000 THEN BEGIN
01990 QSAVE←QRES[QX]; SUMOLD←SUMRES[QX]; P←7;
02000 END;
02010 END;
02020 ⊃ OUTSTR(CRLF&"Q"&CVS(QSAVE)&" S"&CVS(SUMOLD)&" A"&CVS(MAXOLD-MINOLD)&" ");
02030 ⊃ IF P≠0 THEN OUTSTR("P"&CVS(P)&TB);
02040
02050 IF ((QRES[QX]-QREF)>(PERIOD%2))∧(P=0)∧(QX<7) THEN BEGIN
02060 ⊃ OUTSTR(CRLF&"QX="&CVS(QX)&TB&CVS(QRES[QX])&TB&CVS(SUMRES[QX])&TB&CVS(SPAN[QX]));
02070 QX←QX+1; END;
02080 IF P>0 THEN BEGIN
02090 GOOD←GOOD+1; XING←0;
02100 ⊂ Record mark;
02110 IF PITX>2 THEN
02115 WHILE ((BUFT[PITX-1] LSH -15)≥QSAVE)∧(PITX>1) DO
02117 IF PITX>2 THEN BEGIN
02120 PITX←PITX-1; ⊂ QREF←QREF-PERIOD; END;
02130 BUFT[PITX]←(QSAVE LSH 15)+(SUMOLD LAND '77770)+(P LAND '7);
02140 ⊂ PEEK;
02150 SUMREF←SUMOLD; ⊂ PER←QSAVE-QREF; QREF←QSAVE;
02160 PITX←PITX+1;
02170 IF (PER>PERMIN)∧(PER<PERMAX) THEN PERIOD←(2*PERIOD+PER)%3;
02180 FOR I←0 STEP 1 UNTIL 7 DO SUMRES[I]←SPAN[I]←0;
02190 QX←0;
02200 JPP←0;
02210 END;
02220 END;
02230 END;
02240
02250 ⊂ STATE 2 from 0 on + from 1 on alpha with decision;
02260 IF VAL<ALPHA THEN BEGIN
02270 QOLD←QQ-1; SUMP←VAL;
02275
02280 IF VAL<0 THEN BEGIN STATE←0; ⊃ SPOR; END;
02290 END ELSE BEGIN
02300 SUMP←SUMP+VAL; IF VAL>MAX THEN MAX←VAL;
02310 IF SUMP>DELTA THEN BEGIN
02320 XXM←0;
02330 STATE←3; QRES[QX]←QSAVE←QOLD; SUMSAV←SUMOLD;
02340 ⊃ SPOR;
02350 END;
02360 END;
02370
02380 ⊂ STATE 3 from 4 on + from 2 on delta;
02390 IF VAL<0 THEN BEGIN
02400 XXM←XXM+1;
02410 STATE←4; SUMM←MIN←VAL; QNEG←QQ;
02420 ⊃ SPOR;
02430 END ELSE BEGIN
02440 SUMP←SUMP+VAL; IF VAL>MAX THEN MAX←VAL;
02450 END;
02460
02470 ⊂ STATE 4 from 3 on - ;
02480 IF VAL>0 THEN BEGIN
02490 IF XXM<3 THEN BEGIN
02500 STATE←3; SUMP←SUMP+VAL-SUMM;
02510 ⊃ SPOR;
02520 END;
02530 END ELSE BEGIN
02540 SUMM←SUMM+VAL; IF VAL<MIN THEN MIN←VAL;
02550 ⊂ IF SUMM<DELTN THEN BEGIN ;
02560 IF (XXM≥3)∨((SUMM<DELTN)∧((QQ-QNEG)>3)) THEN BEGIN
02570 STATE←5; SUMRES[QX]←SUM←SUMP-SUMM; SUMP←SUMM←0;
02580 XXP←0;
02590 ⊃ SPOR;
02600 END;
02610 END;
02620
02630 ⊂ STATE 5 from 2 on - from 4 on DELTN;
02640 IF VAL>0 THEN BEGIN
02650 STATE←1;
02660 XXP←XXP+1; XING←XING+1;
02670 ⊃ SPOR;
02680 ⊂ Prepare for decision;
02690 MAXOLD←MAX; MINOLD←MIN; SUMRES[QX]←SUMOLD←SUM;
02700 SPAN[QX]←MAX-MIN;
02710 SUMP←MAX←VAL; ⊂ QSAVE←QOLD; QOLD←QQ;
02720 PER←QSAVE-QREF;
02730 END ELSE BEGIN
02740 SUM←SUM-VAL; IF VAL<MIN THEN MIN←VAL;
02750 END;
02760 END;
02770
02780
02790
02800 IF ((QQ-QREF)>(PERIOD*2))∧(P=0) THEN BEGIN
02810 K←0;
02820 FOR I←0 STEP 1 UNTIL 7 DO
02830 IF (SUMRES[I]>K)∧(QRES[I]>(QREF+PERIOD*3%4)) THEN BEGIN K←SUMRES[I];QX←I; END;
02840 IF (K>2000)∧(XING<15) THEN BEGIN
02850 QREF←QSAVE←QRES[QX]; SUMREF←SUMOLD←SUMRES[QX]; P←7;
02860 BUFT[PITX]←(QSAVE LSH 15)+(SUMOLD LAND '77770)+P;
02870 ⊃ OUTSTR(CRLF&"Q"&CVS(QSAVE)&" S"&CVS(SUMOLD)&" A"&CVS(SPAN[QX])&" ");
02880 ⊃ OUTSTR("*P"&CVS(P)&TB);
02890 FOR I←0 STEP 1 UNTIL 7 DO BEGIN "SLIDE"
02900 K←I+QX+1;
02910 IF K≤7 THEN BEGIN
02920 QRES[I]←QRES[K]; SUMRES[I]←SUMRES[K]; SPAN[I]←SPAN[K];
02930 END ELSE SUMRES[I]←SPAN[I]←0;
02940 IF SUMRES[I]=0 THEN DONE "SLIDE";
02950 END;
02960 QX←I;
02970 END ELSE BEGIN
02980 QREF←QREF+PERIOD; GOOD←0;
02990 BUFT[PITX]←QREF LSH 15; PER←PERIOD;
03000 ⊃ OUTSTR(CRLF&"Q"&CVS(QREF)&" ***"&TB);
03010 END;
03020 PITX←PITX+1;
03030 XING←0;
03040 ⊂ PEEK;
03050 ⊃ SPOR;
03060 END;
03070
03080 QQ←QQ+1; P←0;
03090
03100 END "PITCH";
03110
00010 FILEN←"HI20.001[DAT,ALS]";
00020 FILEO←"SEG1.ALS[SYN,ALS]";
00030 PERIOD←180; PERMAX←260; PERMIN←100; MARGIN←50; DELTA←200; DELTN←-100; QQ←0;
00040 SUMMIN←200; ALPHA←100;
00050
00060 STDBRK(1);
00070 SETBREAK(14,"∃",NULL,"INS");
00080 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00090 SETBREAK(16,'56,NULL,"INA");
00100 SETBREAK(17,'12,'15,"INS");
00110
00120 CHAN1←1;CHAN3←3; CHAN5←5;
00130 OUTSTR("This program generates a file of pitch markers similar to "&
00140 "the .P files"&CRLF&" but with extension of .ALS."&CRLF);
00150 OUTSTR("At present this program takes acoustic data from [DAT,ALS],"&
00160 CRLF&TB&"and pulse informstion from .P[PIT,NJM] files"&CRLF&TB&CRLF&LF);
00170
00180
00190 STARTP:
00200
00210 OUTSTR(CRLF&"Type number of file to start (CR only for 1) ");
00220 IF (READ←INCHWL)="" THEN PP←1 ELSE PP←CVD(READ);
00230 OUTSTR("Start display with sample # (CR for first phone) ");
00240 IF (READ←INCHWL)="" THEN BEGIN NVAL[0]←0; JPP←1; END ELSE BEGIN
00250 JPP←0; NVAL[0]←CVD(READ); END;
00260
00270 ⊂ Begin FILEREAD;
00280 FOR PP←PP STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00290 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,2,0,0,0,EOF);
00300 SETFORMAT(-3,0); FILEQ←CVS(PP);
00310 FILEN←FILEN[1 TO 5]&FILEQ&"[DAT,ALS]";
00320 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00330 WHILE ER DO BEGIN
00340 IF PP>1 THEN BEGIN OUTSTR("Out of data, will terminate."&CRLF);
00350 GOTO STOPP; END;
00360 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00370 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00380 J←K←L←STATE←VAL←0; R←-1;
00390 SETFORMAT(1,0); FILEQ←CVS(PP); JP←10000; R←-1; CLRBUF;
00400 II←-11; JJ←-1;
00410
00420 DATAIN; SUMREF←SUMOLD←SUMSAV←SUMMIN;
00430 PITX←0; BUFT[PITX]←1; PITX←1;
00440 FOR J←0 STEP 1 UNTIL 767 DO BEGIN
00450 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00460 D[J]←VAL; PITCH; END;
00470 SEGIN←6; FVAL[1]←FVAL[2]←0;
00480
00490
00500 FILEP←FILEO[1 TO 3]&FILEQ&".ALS[SYN,ALS]";
00510 CLOSE(CHAN5); OPEN(CHAN5,"DSK",'14,0,2,0,0,0);
00520 ENTER(CHAN5,FILEP,0);
00530 OUTSTR("File "&FILEP&" has been opened"&CRLF);
00540
00550
00560 READ2←FILEP;
00570 READTT←SCAN(READ2,16,J)&"P[PIT,NJM]";
00580 ⊂ OUTSTR(READTT&CRLF);
00590 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
00600 LOOKUP(CHAN3,READTT,ER); TFILE←READTT;
00610 IF ER THEN BEGIN
00620 OUTSTR("File "&READTT&" not found (S to start, space bar to ignore) ");
00630 IF (READ1←INCHRW)="S" THEN GOTO STARTP ELSE BEGIN
00640 BUFTT[0]←'77777; BUFTT[1]←'377777700000;ITT←0; JTT←'3777777;
00650 CLRBUF; END; END;
00660
00670 FOR I←1 STEP 1 UNTIL 8 DO FVAL[I]←0;
00680 DTTTIN;
00690 FVAL[4]←BUFTT[0]; FVAL[1]←(FVAL[4] LSH -15)-(SEGIN-6)*128;
00700 FVAL[5]←BUFTT[1]; FVAL[2]←(FVAL[5] LSH -15)-(SEGIN-6)*128;
00710 FVAL[6]←BUFTT[2]; FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-6)*128;KTT←2;
00720 NVAL[5]←BUFT[0]; NVAL[2]←(NVAL[5] LSH -15)-(SEGIN-6)*128;
00730 pity←0;
00740
00750
00760
00770
00780 ⊂ Begin "GET";
00790
00800 WHILE TRUE DO BEGIN "GET"
00810
00820
00830 ⊂ OUTSTR("JTT="&CVS(JTT)&TB&"J="&CVS(J)&CRLF);
00840 IF JJ<SEGIN THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
00850
00860 ⊂ OUTSTR("JJ="&CVS(JTT)&TB&"J="&CVS(J)&"before DTTTIN");
00870 IF JTT<(SEGIN-1)*128 THEN DTTTIN;
00880 ⊂ OUTSTR(" and after JTT="&CVS(JTT)&CRLF);
00890
00900 ⊂ FVAL and NVAL assignments (NVAL are newly computed values)
00910 [1] DELTA FOR FIRST MARKER
00920 [2] DELTA FOR SECOND MARKER
00930 [3] DELTA FOR THIRD MARKER
00940 [4] PULSE DATE FOR FIRST MARKER
00950 [5] PULSE DATA FOR SECOND MARKER
00960 [6] PULSE DATA FOR THIRD MARKER;
00970
00980
00990 NVAL[1]←NVAL[2]; NVAL[4]←NVAL[5];
01000
01010 WHILE NVAL[1]>127 DO BEGIN
01020 IF SEGIN≥JJ THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
01030 FOR Q←0 STEP 1 UNTIL 639 DO D[Q]←D[Q+128];
01040 FOR Q←640 STEP 1 UNTIL 767 DO BEGIN
01050 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
01060 D[Q]←VAL; PITCH; END; SEGIN←SEGIN+1; ⊂ OUTSTR("RELOAD"&CRLF);
01070 FVAL[1]←FVAL[1]-128; FVAL[2]←FVAL[2]-128; FVAL[3]←FVAL[3]-128;
01080 NVAL[1]←NVAL[1]-128; end;
01090
01100 WHILE FVAL[1]<0 DO BEGIN FVAL[1]←FVAL[2]; FVAL[2]←FVAL[3];
01110 FVAL[4]←FVAL[5]; FVAL[5]←FVAL[6];
01120 KTT←KTT+1; IF KTT≥512 THEN DTTTIN;
01130 FVAL[6]←BUFTT[KTT];
01140 FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-6)*128;END;
01150
01160 NVAL[2]←NVAL[3];
01170 PITY←PITY+1;
01180 NVAL[5]←BUFT[PITY];
01190 IF NVAL[5]=0 THEN BEGIN OUTSTR("BUFT[PITY] was zero"&crlf); inchwl; end;
01200 NVAL[2]←(NVAL[5] LSH -15)-(SEGIN-6)*128;
01210
01220 ⊂ OUTSTR(CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&
01230 TB&CVS(FVAL[4] LSH -15)&TB&
01240 CVS(FVAL[5] LSH -15)&TB&CVS(FVAL[6] LSH -15)&CRLF);
01250 ⊂ OUTSTR(CVS(NVAL[1])&TB&CVS(NVAL[2])&TB&CVS(NVAL[3])&
01260 TB&CVS(NVAL[4] LSH -15)&TB&
01270 CVS(NVAL[5] LSH -15)&TB&CVS(NVAL[6] LSH -15)&CRLF);
01280
01290 ⊂ OUTSTR(CRLF&CVS(SEGIN)&TB&CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&TB&
01300 CVS(FVAL[4] LSH -15)&
01310 " "&CVS(FVAL[5] LSH -15)&" "&CVS(FVAL[6] LSH -15)&TB&TB);
01320
01330
01340 R←R+1; IF (K←NVAL[4] LAND '7)=0 THEN OUTSTR(" ") ELSE OUTSTR(CVS(K));
01350 OUTSTR(":"&CVS(NVAL[4] LSH -15)&TB);
01360 IF (R MOD 8)=7 THEN OUTSTR(CRLF);
01370
01380
00010 JP←JP-1; READ1←INCHRS;
00020 IF (READ1="F")∨(READ1="f") THEN BEGIN CLRBUF; READ1←"";
00030 JP←-10; OUTSTR(CRLF&LF&"Will stop at the end of this file"&CRLF&LF); END;
00040 IF (READ1="E")∨(READ1="e") then goto stopp;
00050
00060 IF (READ1=" ")∨((JPP=0)∧((NVAL[5] LSH -15)>NVAL[0])) THEN BEGIN "SHOW"
00070 ⊂ IF (READ1=" ")∨((ABS(FVAL[1]-NVAL[1])>5)∨(ABS(FVAL[2]-NVAL[2])>5)) THEN
00080 BEGIN "SHOW";
00090 TYPLOC(512,120); DPYSET(DPYBUF);
00100 JP←1;
00110 OUTSTR(CRLF&"File "&FILEN&TB);
00120 OUTSTR("from "&CVS(NVAL[4] LSH -15)
00130 &" to "&CVS(NVAL[5] LSH -15)&TB&CVOS(NVAL[4] LAND '77777)&","&
00140 CVOS(NVAL[5] LAND '77777)&TB&CVS(SUMREF)&CRLF);
00150 AIVECT(-599,-200);MARK;
00160 DPYOUT(0);PTOCHW(0,'10120);
00170 ⊂ OUTSTR("Type P for XGP copy file or type next command.");
00180 ⊂ OUTSTR("Space to run, LF for next, # for sample #, +# to add periods."&CRLF);
00190
00200 READ1←INCHRW;
00210 WHILE (READ1="W")∨(READ1="w") DO BEGIN DPYOUT(0) ;
00220 PTOCHW(0,'10120);READ1←INCHRW; END;
00230 IF (READ1="P")∨(READ1="p") THEN BEGIN CALCOMP("PLOTX",DPYBUF);
00240 OUTSTR("EX DPYXGP[X,ALS] plots PLOTX.GRF on the XGP. Next command please."&CRLF);
00250 READ1←INCHRW; END;
00260 K←CVASC(READ1); OPT1←0;
00270
00280 IF K=CVASC("+") THEN BEGIN
00290 JP←CVD(INCHWL); NVAL[0]←10000; END;
00300 IF K≥CVASC("0") THEN IF K≤CVASC("9") THEN BEGIN
00310 NVAL[0]←CVD(READ1&INCHWL); JP←10000; END;
00320 IF(READ1="F")∨(READ1="f") THEN JP←-1;
00330 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
00340
00350 IF (READ1='15)∨(READ1='12) THEN BEGIN JP←1; NVAL[0]←0; CLRBUF; END;
00360
00370 TOFORM:
00380 IF (READ1="S")∨(READ1="s") THEN JP←JP+1;
00390 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
00400 PTOCHW(0,'10103); CLRBUF; TYPLOC(512,-170); PTOCHW(0,'10120);
00410 END "SHOW";
00420
00430
00440 END "GET";
00450 CLOSE(CHAN1); CLOSE(CHAN3);
00460 DATOUT; CLOSE(CHAN5);
00470 IF JP<0 THEN DONE;
00480 END "FILEREAD";
00490
00500 OUTSTR("Data are exhausted"&CRLF&LF);
00510 STOPP: PTOCHW(0,'10103); PTOCHW(0,'10120);
00520 CLOSE(CHAN1);CLOSE(CHAN3);
00530 CLOSE(CHAN5);
00540
00550 END "MARKX";
00560